home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…stman Always Clicks Twice / ADC Developer CD (1993-01) (''The Postman Always Clicks Twice'')_iso / Dev.CD 199301.iso / Development Platforms / LISP Related / LISP Goodies / McCartney-library 1.1 / CODE / oodles-files / GWorld-u.lisp next >
Encoding:
Text File  |  1992-09-02  |  2.0 KB  |  64 lines  |  [TEXT/CCL2]
  1. (in-package  :oou)
  2. ;(oou-provide :GWorld-u)
  3. (provide :GWorld-u)
  4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. ;; GWorld-svm.lisp
  6. ;;
  7. ;; Copyright © 1992 Northwestern University Institute for the Learning Sciences
  8. ;; All Rights Reserved
  9. ;;
  10. ;; author: Michael S. Engber
  11. ;;         Tamar Offer
  12. ;;
  13. ;; utilities for working with GWorlds
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;(oou-dependencies :simple-view-ce
  17. ;                  )
  18. (require :simple-view-ce)
  19.  
  20. (export '(with-focused-GWorld with-locked-GWorld))
  21.  
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23.  
  24. (eval-when (:compile-toplevel :load-toplevel :execute)
  25.  
  26.  
  27.   (defmacro with-locked-GWorld (gWorld &body body)
  28.     (let ((pixMapHandle (gensym))
  29.           (state        (gensym)))
  30.       `(with-macptrs ((,pixMapHandle (require-trap #_GetGWorldPixMap ,gWorld)))
  31.          (let ((,state (require-trap #_GetPixelsState ,pixMapHandle)))
  32.            (unwind-protect
  33.              (if (require-trap #_LockPixels ,pixMapHandle)
  34.                (progn ,@body)
  35.                (error "unable to lock pixels - they've been purged!"))
  36.              (require-trap #_SetPixelsState ,pixMapHandle ,state))))))
  37.  
  38. #|
  39.   (defmacro with-focused-GWorld ((gWorld &optional gDevice '(%null-ptr)) &body body)
  40.     (let ((old-port   (gensym))
  41.           (old-gdh    (gensym))
  42.           (old-port_p (gensym))
  43.           (old-gdh_p  (gensym)))
  44.       `(rlet ((,old-port_p :pointer)
  45.               (,old-gdh_p  :pointer))
  46.          (require-trap #_GetGWorld ,old-port_p ,old-gdh_p)
  47.          (with-macptrs ((,old-port (%get-ptr ,old-port_p))
  48.                         (,old-gdh  (%get-ptr ,old-gdh_p)))
  49.            
  50.            (unwind-protect
  51.              (with-locked-GWorld ,gWorld
  52.                (without-interrupts
  53.                 (require-trap #_SetGWorld ,gWorld ,gDevice)
  54.                 ,@body))
  55.              (require-trap #_SetGWorld ,old-port ,old-gdh))))))
  56.  
  57. |#
  58.  
  59.   )
  60.  
  61.  
  62. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63.  
  64.